home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / rgb16tif / rgb16.bas next >
BASIC Source File  |  1991-10-18  |  5KB  |  118 lines
  1. 10 '      ＲＧＢ１６プログラム   (1991.8.15  PROGRAMED BY K.FUJITA)
  2. 20 '
  3. 30 '　
  4. 40 '  ＊　このプログラムはジーズ・スタッフのベタファイルを
  5. 50 '  　　合成して完全な１６色のＴＩＦＦファイルに
  6. 60 '  　　変換します。
  7. 70 '  
  8. 80 '
  9. 90 '
  10. 100 '
  11. 110 SCREEN@0:CLEAR,,,600000
  12. 120 A=INT((INT(647/8)*480+2-1)/2):B=INT((INT(647/8)*480*4+2-1)/2)
  13. 130 DIM B0%(A),R0%(A),G0%(A)
  14. 140 DIM B1%(A),R1%(A),G1%(A)
  15. 150 DIM A%(B)
  16. 160 '　
  17. 170 CLS:WIDTH 80,25:GOSUB 680
  18. 180 CLS:COLOR 6:PRINT "ジーズスタッフデータのドライブ＆ディレクトリ  ";ZDR$+PAT$:COLOR 7:FILES ZDR$+PAT$:PRINT:INPUT"ファイル名 ",NA$
  19. 190 IF NA$="" THEN 170
  20. 200 IF NA$<>".." THEN 230
  21. 210 IF T1<>1 THEN T1=T1-1
  22. 220 GOSUB 710:GOTO 180
  23. 230 CLS:LOCATE 0,21:ON ERROR GOTO 250:GOTO 270
  24. 240 '
  25. 250 IF ERR=21 THEN RESUME NEXT ELSE GOSUB 920:RESUME 180
  26. 260 '
  27. 270 LOAD@ ZDR$+PAT$+NA$+".B1",B0%
  28. 280 LOAD@ ZDR$+PAT$+NA$+".B1",B1%:PRINT "B1 END";"  ";
  29. 290 LOAD@ ZDR$+PAT$+NA$+".R1",R0%
  30. 300 LOAD@ ZDR$+PAT$+NA$+".R1",R1%:PRINT "R1 END";"  ";
  31. 310 LOAD@ ZDR$+PAT$+NA$+".G1",G0%
  32. 320 LOAD@ ZDR$+PAT$+NA$+".G1",G1%:PRINT "G1 END"
  33. 330 '
  34. 340 LOAD@ ZDR$+PAT$+NA$+".E1",A%
  35. 350 PUT@ (0,0)-(639,479),A%,PSET,7:GET@A (0,0)-(639,479),A%
  36. 360 '
  37. 370 ON ERROR GOTO 0
  38. 380 ' 
  39. 390 CLS:PUT@ (0,0)-(639,479),B1%,PSET,1:PUT@A (0,0)-(639,479),A%,AND
  40. 400 GET@ (0,0)-(639,479),B1%,1
  41. 410 CLS:PUT@ (0,0)-(639,479),R1%,PSET,2:PUT@A (0,0)-(639,479),A%,AND
  42. 420 GET@ (0,0)-(639,479),R1%,2
  43. 430 CLS:PUT@ (0,0)-(639,479),G1%,PSET,4:PUT@A (0,0)-(639,479),A%,AND
  44. 440 GET@ (0,0)-(639,479),G1%,4
  45. 450 CLS:PUT@A (0,0)-(639,479),A%,PSET
  46. 460  PUT@A (0,0)-(639,479),A%,NOT:GET@A (0,0)-(639,479),A%
  47. 470 ' 
  48. 480 CLS:PUT@ (0,0)-(639,479),B0%,PSET,1:PUT@A (0,0)-(639,479),A%,AND
  49. 490 GET@ (0,0)-(639,479),B0%,1
  50. 500 CLS:PUT@ (0,0)-(639,479),R0%,PSET,2:PUT@A (0,0)-(639,479),A%,AND
  51. 510 GET@ (0,0)-(639,479),R0%,2
  52. 520 CLS:PUT@ (0,0)-(639,479),G0%,PSET,4:PUT@A (0,0)-(639,479),A%,AND
  53. 530 GET@ (0,0)-(639,479),G0%,4
  54. 540 CLS:PUT@A (0,0)-(639,479),A%,PSET
  55. 550 PUT@A (0,0)-(639,479),A%,NOT:GET@ (0,0)-(639,479),A%,7
  56. 560 '
  57. 570 CLS
  58. 580 PUT@ (0,0)-(639,479),B0%,OR,%1
  59. 590 PUT@ (0,0)-(639,479),B1%,OR,%9
  60. 600 PUT@ (0,0)-(639,479),R0%,OR,%2
  61. 610 PUT@ (0,0)-(639,479),R1%,OR,%10
  62. 620 PUT@ (0,0)-(639,479),G0%,OR,%4
  63. 630 PUT@ (0,0)-(639,479),G1%,OR,%12
  64. 640 PUT@ (0,0)-(639,479),A%,OR,%8
  65. 650 ON ERROR GOTO 970
  66. 660 SAVE@ SDR$+PAT2$+NA$+".TIF",(0,0)-(639,399):GOTO 180
  67. 670 CLS:PRINT ERL,ERR:END
  68. 680 '
  69. 690 PAT$(0)="\":PAT2$(0)="\":T1=1:T2=1:DC=0:ZDR$="":SDR$=""
  70. 700 CLS:INPUT"ジーズスタッフのデータがあるドライブは？　",ZDR$
  71. 705 ZDR$=ZDR$+":"
  72. 710 ON ERROR GOTO 1060
  73. 720 CLS:COLOR 6:PRINT "ジーズスタッフデータのドライブ＆ディレクトリ  ";ZDR$+PAT$(T1-1):COLOR 7:FILES ZDR$+PAT$(T1-1)
  74. 730 PRINT
  75. 740 INPUT "ディレクトリ名は（必要無い時はＣＲ）？　",PA$:IF PA$="" THEN 770
  76. 750 IF PA$=".." THEN IF T1=1 THEN 690 ELSE T1=T1-1:GOTO 720
  77. 760 PAT$(T1)=PAT$(T1-1)+PA$+"\":T1=T1+1:GOTO 720
  78. 770 IF DC=1 THEN 780 ELSE CLS:INPUT"セーブ用のドライブは？　",SDR$
  79. 775 SDR$=SDR$+":"
  80. 780 ON ERROR GOTO 1100
  81. 790 CLS:COLOR 6:PRINT "セーブ用のドライブ＆ディレクトリ  ";SDR$+PAT2$(T2-1):COLOR 7:FILES SDR$+PAT2$(T2-1)
  82. 800 PRINT
  83. 810 INPUT "ディレクトリ名は（必要無い時はＣＲ）？　",PA$:IF PA$="" THEN 850
  84. 820 IF PA$<>".." THEN 840
  85. 830 IF T2=1 THEN DC=0:GOTO 770 ELSE T2=T2-1:GOTO 790
  86. 840 PAT2$(T2)=PAT2$(T2-1)+PA$+"\":T2=T2+1:GOTO 790
  87. 850 CLS
  88. 860 PAT$=PAT$(T1-1):PAT2$=PAT2$(T2-1):PRINT ZDR$+PAT$
  89. 870 PRINT :IF LEN(PAT$)<LEN(PAT2$) THEN L=LEN(PAT$) ELSE L=LEN(PAT2$)
  90. 880 PRINT SPACE$(L/2)+"↓":PRINT
  91. 890 PRINT SDR$+PAT2$
  92. 900 PRINT :INPUT"これで良いですか（悪い時は N キー）　",NA$:IF NA$="N" OR NA$="n" THEN CLS:GOTO 680
  93. 910 DC=1:RETURN
  94. 920 '
  95. 930 CLS:COLOR 2:LOCATE 0,10:IF ERR=63 THEN PRINT "指定のファイルが見つかりません":GOTO 950
  96. 940 PRINT "エラー";ERR;" が発生！"
  97. 950 COLOR 6:PRINT :PRINT "何かキーを押して下さい":COLOR 6
  98. 960 A$=INKEY$:IF A$="" THEN 960 ELSE RETURN
  99. 970 '
  100. 980 IF ERR<>64 THEN GOSUB 920:RESUME 180
  101. 990 GET@A (0,0)-(639,479),A%
  102. 1000 CLS:COLOR 6:LOCATE 0,10:PRINT "同じファイル名があります。":COLOR 7
  103. 1010 INPUT"上書きしますか？（する時は Y）",A$
  104. 1020 IF A$<>"Y" AND A$<>"y" AND A$<>"ん" THEN RESUME 180
  105. 1030 KILL SDR$+PAT2$+NA$+".TIF"
  106. 1040  PUT@A (0,0)-(639,479),A%
  107. 1050 RESUME 660
  108. 1060 '
  109. 1070 IF ERR=60 OR ERR=72 THEN RESUME 690
  110. 1080 IF ERR<>63 THEN GOSUB 920
  111. 1090 T1=T1-1:IF T1=0 THEN T1=1:RESUME 700
  112. 1095 RESUME 720
  113. 1100 '
  114. 1110 IF ERR=60 OR ERR=72 THEN SDR$="":DC=0:RESUME 770
  115. 1120 IF ERR<>63 THEN GOSUB 920
  116. 1130 T2=T2-1:IF T2=0 THEN T2=1:RESUME 770
  117. 1140 RESUME 790
  118.